module Traversing where

import Prelude hiding ( mapM )
import Common
import Control.Monad.Writer hiding ( mapM )
import Data.List 
import Data.Set ( Set )
import Data.Traversable
import qualified Data.Set as Set

class WithinTraversable t f where
  mapWithinM :: Monad m => (t -> m t) -> f -> m f
  
mapWithin :: WithinTraversable t f => (t -> t) -> f -> f
mapWithin = mapM_to_fmap mapWithinM

replaceWithin :: (WithinTraversable t f, Eq t) => t -> t -> f -> f
replaceWithin = genericReplace mapWithin

withinList :: WithinTraversable t f => f -> [t]
withinList = execWriter . mapWithinM (\t -> tell [t] >> return t)

strictlyWithinList :: (WithinTraversable t t, Eq t) => t -> [t]
strictlyWithinList t = filter (/= t) (withinList t)

contains :: (WithinTraversable t f, Eq t) => f -> t -> Bool
contains f = flip elem (withinList f)

containsStrictly :: (WithinTraversable t t, Eq t) => t -> t -> Bool
containsStrictly t = flip elem (strictlyWithinList t)

type Substitution a = Set (a, a)

substitute :: (Functor f, Eq a) => 
  Substitution a -> f a -> f a
substitute = flip $ Set.fold $ \(v1, v2) f -> replace v1 v2 f

class Unifiable a where
  unify :: a -> a -> Substitution a

substituteWithin :: (WithinTraversable t f, Eq t) =>
  Substitution t -> f -> f
substituteWithin = flip $ Set.fold $ \(t1, t2) f -> replaceWithin t1 t2 f

allUnifiers :: (Unifiable t, WithinTraversable t f, Eq t) => 
  t -> f -> [Substitution t]
allUnifiers from =
  let unifiers to = tell [unify from to] >> return to
  in execWriter . (mapWithinM unifiers)
  
isOneToOne :: Eq a => Substitution a -> Bool
isOneToOne sub = 
  let (_, rs) = unzip $ Set.toList sub in
  isOneToMany sub && not (containsDuplicates rs)
  
isOneToMany :: Eq a => Substitution a -> Bool
isOneToMany sub =                       
  let (ls, _) = unzip $ Set.toList sub in 
  not (containsDuplicates ls) 

  
